DAG analysis
danhicks
2022-07-21
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──## ✔ ggplot2 3.3.5 ✔ purrr 0.3.4
## ✔ tibble 3.1.6 ✔ dplyr 1.0.8
## ✔ tidyr 1.2.0 ✔ stringr 1.4.0
## ✔ readr 2.1.2 ✔ forcats 0.5.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()theme_set(theme_minimal())
library(broom)
library(patchwork)
library(ggbeeswarm)
library(dagitty)
library(ggdag)##
## Attaching package: 'ggdag'## The following object is masked from 'package:stats':
##
## filter## <https://cran.r-project.org/web/packages/ggdag/vignettes/intro-to-ggdag.html>
library(gt)
library(flextable)##
## Attaching package: 'flextable'## The following object is masked from 'package:purrr':
##
## composelibrary(officer)
library(gtsummary)##
## Attaching package: 'gtsummary'## The following objects are masked from 'package:flextable':
##
## as_flextable, continuous_summary## Need Hmisc for bootstrap CIs in some plots, but don't want to load it
find.package('Hmisc')## [1] "/Users/danhicks/Library/Caches/org.R-project.R/R/renv/library/transparency-b4b6f02c/R-4.1/x86_64-apple-darwin17.0/Hmisc"library(here)## here() starts at /Users/danhicks/Google Drive/Writing/transparency## Helper functions for regression tables, DAG visualization, and effects and prediction plots for regression models
source(here('R', 'reg_tbl.R'))
source(here('R', 'plot_adjustments.R'))
source(here('R', 'reg_plots.R'))
## More readable contrasts in regression models
library(car)## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:dplyr':
##
## recode## The following object is masked from 'package:purrr':
##
## someoptions(contrasts = c('contr.Treatment', 'contr.poly'))
options(decorate.contr.Treatment = '')
out_dir = here('out')
if (!dir.exists(out_dir)) {
dir.create(out_dir)
}
data_dir = here('data')Load data
## Load data ----
## Elliott et al. data
emad_df = read_rds(here(data_dir, 'emad.Rds'))
## Our data
dataf = read_rds(here(data_dir, 'data.Rds'))Descriptive summary of our data
## Descriptive summary of our data ----Demographics
- age
- gender
- race/ethnicity
- https://www.census.gov/library/visualizations/interactive/race-and-ethnicity-in-the-united-state-2010-and-2020-census.html
- overrep White (72% vs. 62%)
- underrep Hispanic (3% vs. 19%)
- Black and A/PI represented accurately at 13% and 6%
- religious affiliation
- religious services
- political ideology
- political affiliation
- education
- https://www.statista.com/statistics/184260/educational-attainment-in-the-us/
- underrep non-HS grads (1% vs. 9%)
- overrep college grads (57% vs. 38%)
- participant values
Several of our variables allow respondents to select multiple values, eg, race-ethnicity. These are downloaded as factors, with levels such as 5 or 2,4,5. We recode these as characters for the demographic summary table. Because these are just used as adjustment variables in the analysis, we don’t recode them for use below.
re_labels = c('American Indian or Alaskan Native',
'Asian or Pacific Islander',
'Black',
'Hispanic',
'White',
'Other',
'Prefer not to answer')
relig_labels = c('Buddhist',
'Catholic',
'Hindu',
'Jewish',
'Muslim',
'Protestant',
'No religion',
'Other', 'Prefer not to answer')
relig_serv_labels = c('Never',
'A few times per year',
'Once every month or two',
'2-3 times per month',
'Once per week',
'More than once per week',
'Daily')
poli_id_labels = c('Strongly liberal',
'Moderately liberal',
'Mildly liberal',
'Centrist',
'Mildly conservative',
'Moderately conservative',
'Strongly conservative',
'Other',
'Prefer not to answer')
poli_aff_labels = c('Democratic party',
'Republican party',
'Independent/no party',
'Other',
'Prefer not to answer')
edu_labels = c('Less than high school',
'High school, or some college',
'Bachelor’s degree or higher')
fix_multifac = function(vec, labs, ordered = FALSE) {
chr = vec |>
as.character() |>
str_split(',') |>
map(~ labs[as.integer(.x)]) |>
map_chr(str_c, collapse = '/')
if (!ordered) {
return(chr)
} else {
fct_relevel(chr, labs)
}
}
demo_gt = dataf |>
select(pid, age, gender, race_ethnicity,
religious_affil, religious_serv,
political_ideology, political_affiliation,
education, part_values, disclosure) |>
mutate(gender = fct_drop(gender),
race_ethnicity = fix_multifac(race_ethnicity, re_labels),
religious_affil = fix_multifac(religious_affil, relig_labels),
religious_serv = fix_multifac(religious_serv,
relig_serv_labels,
ordered = TRUE),
political_ideology = fix_multifac(political_ideology,
poli_id_labels,
ordered = TRUE),
political_affiliation = fix_multifac(political_affiliation,
poli_aff_labels),
education = fix_multifac(education, edu_labels, ordered = TRUE)) |>
select(-pid) |>
tbl_summary(label = list(race_ethnicity ~ 'race/ethnicity',
religious_affil ~ 'religious affiliation',
religious_serv ~ 'religious service attendance',
political_ideology ~ 'political ideology',
political_affiliation ~ 'political affiliation',
part_values ~ 'participant values'),
sort = list(race_ethnicity ~ 'frequency',
religious_affil ~ 'frequency')) |>
bold_labels()## Warning: Unknown levels in `f`: Other, Prefer not to answerdemo_gt |>
as_flex_table() |>
save_as_docx(path = here(out_dir, '03_demo_table.docx'),
pr_section = prop_section(
page_size = page_size(orient = "landscape")
)
)Condition assignment
condition_tbl = dataf |>
mutate(disclose_values = case_when(
!disclosure ~ 'no disclosure',
disclosure ~ sci_values),
disclose_values = fct_relevel(disclose_values,
'no disclosure',
'public health',
'economic growth')) |>
select(disclose_values, conclusion) |>
tbl_summary(by = conclusion,
label = list(disclose_values ~ 'disclosure/values'))
condition_tbl| Characteristic | causes harm, N = 4961 | does not cause harm, N = 4921 |
|---|---|---|
| disclosure/values | ||
| no disclosure | 163 (33%) | 165 (34%) |
| public health | 168 (34%) | 162 (33%) |
| economic growth | 165 (33%) | 165 (34%) |
| 1 n (%) | ||
write_reg_tbl(condition_tbl, here(out_dir, '03_condition_tbl'))Trust, overall
## Trust, overall ----
ggplot() +
geom_violin(aes(x = 'EMAD', pa_mean),
draw_quantiles = .5,
data = emad_df) +
geom_beeswarm(aes(x = 'EMAD', pa_mean),
data = emad_df) +
geom_violin(aes(x = 'HL', meti_mean),
draw_quantiles = .5,
data = dataf) +
geom_beeswarm(aes(x = 'HL', meti_mean),
data = dataf) +
ylab('mean trust')
Across our dataset, standard deviation of mean trust is 1.3 on the 1-7 scale
sd(dataf$meti_mean)## [1] 1.288985H1. Modest correlation between values and ideology
## H1. Modest correlation between values and ideology ----(i) Political liberals are more likely to prioritize public health over economic growth, compared to political conservatives; but (ii) a majority of political conservatives prioritize public health.
NB 1. No DAG here because this isn’t a causal claim. 2. Direction of ideology coding is reversed between the two studies.
Compared to Elliott et al., our strong conservatives placed lower value on public health, and overall conservatives are about 50-50.
emad_df |>
count(ideology, tradeoff) |>
group_by(ideology) |>
mutate(share = n / sum(n)) |>
ungroup() |>
ggplot(aes(ideology, n, fill = as.factor(tradeoff))) +
geom_col() +
scale_fill_viridis_d()
last_plot() + aes(y = share)
part_values_plot = dataf |>
filter(!is.na(pref)) |>
count(political_ideology, part_values) |>
group_by(political_ideology) |>
mutate(share = n / sum(n)) |>
ungroup() |>
ggplot(aes(political_ideology, n, fill = part_values)) +
geom_col(color = 'black') +
scale_x_continuous(labels = NULL,
name = '← liberal conservative →\npolitical ideology') +
scale_fill_viridis_d(option = 'E', name = 'participant\nvalues')
part_values_plot## Warning: Removed 2 rows containing missing values (position_stack).
part_values_share = part_values_plot + aes(y = share) +
scale_y_continuous(labels = scales::percent_format())
part_values_share## Warning: Removed 2 rows containing missing values (position_stack).
part_values_plot + part_values_share +
plot_layout(guides = 'collect') +
plot_annotation(tag_levels = 'A')## Warning: Removed 2 rows containing missing values (position_stack).
## Removed 2 rows containing missing values (position_stack).
ggsave(here(out_dir, '03_part_values.png'),
height = 4, width = 8, dpi = 200, scale = 1.5)## Warning: Removed 2 rows containing missing values (position_stack).
## Removed 2 rows containing missing values (position_stack).table(dataf$political_ideology, dataf$pref)##
## 1 2 3 4
## 1 5 1 18 133
## 2 9 13 47 135
## 3 5 14 44 66
## 4 16 19 31 39
## 5 13 18 22 27
## 6 22 27 18 25
## 7 19 9 3 6dataf |>
mutate(political_ideology = case_when(
political_ideology < 4 ~ 'liberal',
political_ideology == 4 ~ 'moderate',
political_ideology > 4 ~ 'conservative'
)) |>
count(political_ideology)## # A tibble: 4 × 2
## political_ideology n
## <chr> <int>
## 1 conservative 248
## 2 liberal 574
## 3 moderate 118
## 4 <NA> 48cor(emad_df$ideology, emad_df$tradeoff,
use = 'complete.obs',
method = 'spearman')## [1] 0.2717778cor(as.integer(dataf$political_ideology), as.integer(dataf$pref),
use = 'complete.obs',
method = 'spearman')## [1] -0.4712353glm(I(part_values == 'economic growth') ~ political_ideology,
family = 'binomial',
data = dataf) |>
summary()##
## Call:
## glm(formula = I(part_values == "economic growth") ~ political_ideology,
## family = "binomial", data = dataf)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.5838 -0.6027 -0.4484 -0.3306 2.4225
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.51269 0.24200 -14.52 <2e-16 ***
## political_ideology 0.63300 0.05455 11.61 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 879.25 on 803 degrees of freedom
## Residual deviance: 711.42 on 802 degrees of freedom
## (184 observations deleted due to missingness)
## AIC: 715.42
##
## Number of Fisher Scoring iterations: 5DAG
## DAG ----We use the following DAG throughout the rest of this analysis
dag = dagify(METI ~ shared_values + sci_values +
part_values + demographics,
shared_values ~ part_values + sci_values,
part_values ~ demographics,
outcome = 'METI') |>
tidy_dagitty(layout = 'kk')
ggplot(dag, aes(x = x, y = y,
xend = xend, yend = yend)) +
geom_label(aes(label = name)) +
geom_dag_edges() +
coord_cartesian(clip = 'off') +
theme_dag()
H2. Consumer risk sensitivity
## H2. Consumer risk sensitivity ----Scientists who find that a chemical harms human health are perceived as more trustworthy than scientists who find that a chemical does not cause harm.
ggplot(emad_df, aes(conclusion, pa_mean)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()
ggplot(dataf, aes(conclusion, meti_mean)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()
Because the conclusion is experimentally manipulated, we don’t need any adjustments.
dag |>
add_arrows('conclusion -> METI') |>
plot_adjustments(exposure = 'conclusion') +
scale_color_manual(values = 'black')
model_b_emad = lm(pa_mean ~ conclusion, data = emad_df)
summary(model_b_emad)##
## Call:
## lm(formula = pa_mean ~ conclusion, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.6131 -0.8536 0.1012 1.1464 2.4321
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.61306 0.08953 62.693 < 2e-16 ***
## conclusion[does not cause harm] -1.04516 0.12415 -8.418 4.12e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.384 on 496 degrees of freedom
## Multiple R-squared: 0.125, Adjusted R-squared: 0.1233
## F-statistic: 70.87 on 1 and 496 DF, p-value: 4.121e-16model_b = lm(meti_mean ~ conclusion, data = dataf)
summary(model_b)##
## Call:
## lm(formula = meti_mean ~ conclusion, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8315 -0.7601 0.0256 0.8730 2.5158
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.47437 0.05346 102.40 <2e-16 ***
## conclusion[does not cause harm] -0.99019 0.07576 -13.07 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.191 on 986 degrees of freedom
## Multiple R-squared: 0.1477, Adjusted R-squared: 0.1468
## F-statistic: 170.8 on 1 and 986 DF, p-value: < 2.2e-16plot_residuals(model_b)## `geom_smooth()` using formula 'y ~ x'
plot_estimate(list(emad = model_b_emad,
hl = model_b),
str_detect(term, 'conclusion'))
tbl_regression(model_b, intercept = TRUE) |>
add_glance_table(include = c(r.squared, nobs, statistic, p.value))| Characteristic | Beta | 95% CI1 | p-value |
|---|---|---|---|
| (Intercept) | 5.5 | 5.4, 5.6 | <0.001 |
| conclusion | |||
| conclusion[does not cause harm] | -1.0 | -1.1, -0.84 | <0.001 |
| R² | 0.148 | ||
| No. Obs. | 988 | ||
| Statistic | 171 | ||
| p-value | <0.001 | ||
| 1 CI = Confidence Interval | |||
list(emad = model_b_emad,
hl = model_b) |>
reg_tbl()| Characteristic | EMAD | HL replication | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.6 | 5.4, 5.8 | <0.001 | 5.5 | 5.4, 5.6 | <0.001 |
| conclusion | ||||||
| conclusion[does not cause harm] | -1.0 | -1.3, -0.80 | <0.001 | -1.0 | -1.1, -0.84 | <0.001 |
| R² | 0.125 | 0.148 | ||||
| No. Obs. | 498 | 988 | ||||
| Adjusted R² | 0.123 | 0.147 | ||||
| Statistic | 70.9 | 171 | ||||
| p-value | <0.001 | <0.001 | ||||
| 1 CI = Confidence Interval | ||||||
H3. Transparency penalty
## H3. Transparency penalty ----Scientists who disclose values are perceived as less trustworthy than scientists who do not.
trans_plot_emad = ggplot(emad_df, aes(disclosure, pa_mean)) +
# geom_violin(draw_quantiles = .5) +
geom_beeswarm(alpha = .25, size = .3) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(geom = 'line', group = 1L, color = 'red') +
labs(y = 'trust')
trans_plot_emad## No summary function supplied, defaulting to `mean_se()`
trans_plot_us = ggplot(dataf, aes(disclosure, meti_mean)) +
geom_beeswarm(alpha = .25, size = .3) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(geom = 'line', group = 1L, color = 'red') +
labs(y = 'trust')
trans_plot_us## No summary function supplied, defaulting to `mean_se()`
trans_plot_emad +
ggtitle('EMAD') +
trans_plot_us +
ggtitle('HL replication')## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`
ggsave(here(out_dir, '03_transparency.png'),
height = 3, width = 6, scale = 1,
bg = 'white')## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`Again, disclosure/transparency is experimentally controlled, so no adjustment is required.
dag |>
add_arrows('disclose -> METI') |>
plot_adjustments('disclose') +
scale_color_manual(values = 'black')
model_c_emad = lm(pa_mean ~ disclosure, data = emad_df)
summary(model_c_emad)##
## Call:
## lm(formula = pa_mean ~ disclosure, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.3917 -0.9519 0.1798 1.2231 2.0802
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.3917 0.1164 46.316 < 2e-16 ***
## disclosure[TRUE] -0.4719 0.1409 -3.349 0.000871 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.463 on 496 degrees of freedom
## Multiple R-squared: 0.02212, Adjusted R-squared: 0.02015
## F-statistic: 11.22 on 1 and 496 DF, p-value: 0.0008714model_c = lm(meti_mean ~ disclosure, data = dataf)
summary(model_c)##
## Call:
## lm(formula = meti_mean ~ disclosure, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9447 -0.9120 0.0880 0.9839 2.0553
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.05488 0.07115 71.045 <2e-16 ***
## disclosure[TRUE] -0.11018 0.08705 -1.266 0.206
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.289 on 986 degrees of freedom
## Multiple R-squared: 0.001622, Adjusted R-squared: 0.0006095
## F-statistic: 1.602 on 1 and 986 DF, p-value: 0.2059plot_residuals(model_c)## `geom_smooth()` using formula 'y ~ x'
# plot_estimate(model_c, 'disclosure')
plot_estimate(list(emad = model_c_emad,
hl = model_c),
str_detect(term, 'disclosure'))
list(emad = model_c_emad,
hl = model_c) |>
reg_tbl()| Characteristic | EMAD | HL replication | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.4 | 5.2, 5.6 | <0.001 | 5.1 | 4.9, 5.2 | <0.001 |
| disclosure | ||||||
| disclosure[TRUE] | -0.47 | -0.75, -0.20 | <0.001 | -0.11 | -0.28, 0.06 | 0.2 |
| R² | 0.022 | 0.002 | ||||
| No. Obs. | 498 | 988 | ||||
| Adjusted R² | 0.020 | 0.001 | ||||
| Statistic | 11.2 | 1.60 | ||||
| p-value | <0.001 | 0.2 | ||||
| 1 CI = Confidence Interval | ||||||
H2 + H3 combined table
## H2 + H3 combined table ----
model_bc_emad = lm(pa_mean ~ conclusion + disclosure, data = emad_df)
model_bc = lm(meti_mean ~ conclusion + disclosure, data = dataf)
bc_tbl = list(emad = model_bc_emad,
hl = model_bc) |>
reg_tbl()
bc_tbl| Characteristic | EMAD | HL replication | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 6.0 | 5.7, 6.2 | <0.001 | 5.6 | 5.4, 5.7 | <0.001 |
| conclusion | ||||||
| conclusion[does not cause harm] | -1.1 | -1.3, -0.82 | <0.001 | -1.0 | -1.1, -0.84 | <0.001 |
| disclosure | ||||||
| disclosure[TRUE] | -0.52 | -0.78, -0.26 | <0.001 | -0.12 | -0.28, 0.04 | 0.14 |
| R² | 0.152 | 0.150 | ||||
| No. Obs. | 498 | 988 | ||||
| Adjusted R² | 0.148 | 0.148 | ||||
| Statistic | 44.3 | 86.6 | ||||
| p-value | <0.001 | <0.001 | ||||
| 1 CI = Confidence Interval | ||||||
write_reg_tbl(bc_tbl, here(out_dir, '03_bc_tbl'))H4. Shared values
## H4. Shared values ----Given that the scientist discloses values, if the participant and the scientist share the same values, the scientist is perceived as more trustworthy than if the participant and scientist have discordant values.
Quick descriptive plots suggest support for this hypothesis. But we need to consider possible confounding.
emad_df |>
filter(disclosure, !is.na(part_values)) |>
ggplot(aes(shared_values, pa_mean)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()
dataf |>
filter(disclosure, !is.na(part_values)) |>
ggplot(aes(shared_values, meti_mean)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()
H4 DAG discussion
## H4 DAG discussion ----In our actual situation, we only need to adjust for participant values and scientist values; participant values is on every back-door path running through demographics.
plot_adjustments(dag, 'shared_values') +
coord_cartesian(clip = 'off')
ggsave(here(out_dir, '03_shared_values_dag.png'),
height = 3, width = 6, dpi = 200, scale = 1.5)However, if participant values and shared values had some common cause problem_var, then participant values is a collider between problem_var and demographics; either we control for problem_var or we control all the demographics (and possibly worry about the exact structure of the demographics subgraph). Big problem if we didn’t observe problem_var! Fortunately we know by construction of shared values that there is no such common cause.
dag |>
add_arrows(c('problem_var -> shared_values',
'problem_var -> part_values')) |>
plot_adjustments('shared_values')
This doesn’t happen if we have a problem variable elsewhere, because participant values is not a collider on any path that might result.
dag |>
add_arrows(c('part_values <- problem_var -> demographics')) |>
plot_adjustments('shared_values')
So, all together, we just need to adjust for participant values and scientist values.
model_d_emad = emad_df |>
filter(disclosure) %>%
lm(pa_mean ~ shared_values + part_values + sci_values, data = .)
summary(model_d_emad)##
## Call:
## lm(formula = pa_mean ~ shared_values + part_values + sci_values,
## data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.0914 -0.9710 0.0515 1.0508 2.4678
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.6795 0.1663 28.138 <2e-16 ***
## shared_values[TRUE] 0.2915 0.1663 1.753 0.0805 .
## part_values[public health] -0.1473 0.1663 -0.886 0.3763
## sci_values[public health] 0.4119 0.1663 2.477 0.0138 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.466 on 335 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.03948, Adjusted R-squared: 0.03088
## F-statistic: 4.59 on 3 and 335 DF, p-value: 0.003648model_d = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values + part_values + sci_values, data = .)
summary(model_d)##
## Call:
## lm(formula = meti_mean ~ shared_values + part_values + sci_values,
## data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8416 -0.8981 -0.0559 0.9590 2.4590
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.71968 0.13216 35.711 < 2e-16 ***
## shared_values[TRUE] 0.09958 0.13216 0.753 0.451
## part_values[public health] -0.17873 0.13216 -1.352 0.177
## sci_values[public health] 0.62967 0.13216 4.764 2.41e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 563 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.0701, Adjusted R-squared: 0.06514
## F-statistic: 14.15 on 3 and 563 DF, p-value: 6.696e-09plot_residuals(model_d)## `geom_smooth()` using formula 'y ~ x'
# plot_estimate(model_d, 'shared_values')
plot_estimate(list(emad = model_d_emad,
hl = model_d),
str_detect(term, 'shared_values'))
H4 demographics robustness check
## H4 demographics robustness check ----But we can include demographics to check the accuracy of the DAG and robustness of the estimates. This works as expected: adding other demographics basically doesn’t change the estimated effect for shared values (.10 (SE .13) vs. .07 (SE .14)).
model_d1 = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values + part_values + sci_values +
age + gender + race_ethnicity + religious_affil + religious_serv +
political_ideology + education,
data = .)
broom::tidy(model_d1)## # A tibble: 47 × 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 4.48 0.410 10.9 5.54e-25
## 2 shared_values[TRUE] 0.0703 0.144 0.489 6.25e- 1
## 3 part_values[public health] -0.170 0.161 -1.05 2.93e- 1
## 4 sci_values[public health] 0.620 0.142 4.36 1.56e- 5
## 5 age -0.00175 0.00389 -0.451 6.52e- 1
## 6 gender[Man/Male.Man/Male] 0.207 0.116 1.78 7.51e- 2
## 7 gender[Man/Male.Woman/Female] 1.09 0.925 1.17 2.41e- 1
## 8 gender[Genderqueer/Gender non-binary/G… -1.29 0.917 -1.40 1.61e- 1
## 9 gender[Genderqueer/Gender non-binary/G… -0.691 0.949 -0.728 4.67e- 1
## 10 gender[Woman/Female.Man/Male] 0.498 0.767 0.650 5.16e- 1
## # … with 37 more rowsIn addition, participant values is independent of shared values: from a participant’s perspective (given their values), they have an equal chance of seeing a scientist with same or different values.
dataf |>
filter(disclosure) |>
count(part_values, sci_values, shared_values)## # A tibble: 6 × 4
## part_values sci_values shared_values n
## <chr> <chr> <lgl> <int>
## 1 economic growth economic growth TRUE 66
## 2 economic growth public health FALSE 55
## 3 public health economic growth FALSE 225
## 4 public health public health TRUE 221
## 5 <NA> economic growth NA 39
## 6 <NA> public health NA 54So dropping participant values from the regression doesn’t change the estimated effect of shared values.
model_d2 = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values + sci_values, data = .)
summary(model_d2)##
## Call:
## lm(formula = meti_mean ~ shared_values + sci_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8799 -0.8799 -0.0529 0.9851 2.4215
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.57851 0.08111 56.447 < 2e-16 ***
## shared_values[TRUE] 0.11272 0.13190 0.855 0.393
## sci_values[public health] 0.61720 0.13194 4.678 3.63e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.286 on 564 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.06708, Adjusted R-squared: 0.06377
## F-statistic: 20.28 on 2 and 564 DF, p-value: 3.139e-09But scientist values does confound the estimate.
model_d3 = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values, data = .)
summary(model_d3)##
## Call:
## lm(formula = meti_mean ~ shared_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7379 -0.9522 -0.0236 0.9954 2.3003
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.69974 0.07827 60.047 < 2e-16 ***
## shared_values[TRUE] 0.46676 0.11001 4.243 2.58e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.31 on 565 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.03088, Adjusted R-squared: 0.02916
## F-statistic: 18 on 1 and 565 DF, p-value: 2.579e-05Scientist values
## Scientist values ----We didn’t specify this possibility in advance, but the analysis for H4 suggests scientist values, not shared values, have an effect. This is randomly assigned, so no adjustments needed.
plot_adjustments(dag, 'sci_values') +
scale_color_manual(values = 'black')
model_emad_s = emad_df |>
filter(disclosure) %>%
lm(pa_mean ~ sci_values, data = .)
model_s = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ sci_values, data = .)
summary(model_s)##
## Call:
## lm(formula = meti_mean ~ sci_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8398 -0.8565 -0.0496 1.0185 2.3790
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.62100 0.07089 65.185 < 2e-16 ***
## sci_values[public health] 0.64740 0.10025 6.458 2.07e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.288 on 658 degrees of freedom
## Multiple R-squared: 0.0596, Adjusted R-squared: 0.05817
## F-statistic: 41.7 on 1 and 658 DF, p-value: 2.067e-10plot_estimate(list('emad' = model_emad_s,
'hl' = model_s),
str_detect(term, 'sci_values'))
dataf |>
filter(disclosure, !is.na(part_values)) |>
ggplot(aes(sci_values, meti_mean)) +
# geom_violin(draw_quantiles = .5) +
geom_beeswarm(dodge.width = 1, alpha = .25) +
geom_ribbon(data = plot_predictions(model_s,
focal_vars = 'sci_values',
return_plot = FALSE),
aes(y = .fitted, ymin = .lower, ymax = .upper),
alpha = .25, group = 1L, fill = 'blue') +
geom_line(data = plot_predictions(model_s,
focal_vars = 'sci_values',
return_plot = FALSE),
aes(y = .fitted, ymin = .lower, ymax = .upper),
alpha = 1, group = 1L, fill = 'blue')## Warning: Ignoring unknown parameters: fill## Warning: Ignoring unknown aesthetics: ymin, ymax
For the paper, we’ll combine all of these models into one big table
shared_values_tbl = list(univariate = tbl_regression(model_d3,
intercept = TRUE,
label = c(shared_values ~ 'shared values')),
sci_values = tbl_regression(model_d2,
intercept = TRUE,
label = c(shared_values ~ 'shared values',
sci_values ~ 'scientist values')),
part_values = tbl_regression(model_d,
intercept = TRUE,
label = c(shared_values ~ 'shared values',
sci_values ~ 'scientist values',
part_values ~ 'participant values')),
demo = tbl_regression(model_d1,
intercept = TRUE,
label = c(shared_values ~ 'shared values',
sci_values ~ 'scientist values',
part_values ~ 'participant values',
religious_serv ~ 'rel. serv. attendance',
political_ideology ~ 'political id.'),
include = -c(gender, race_ethnicity,
religious_affil)),
sci_values_alone = tbl_regression(model_s,
intercept = TRUE,
label = c(sci_values ~ 'scientist values'))) |>
map(add_glance_table, include = c(r.squared, nobs, adj.r.squared,
statistic, p.value)) |>
tbl_merge(tab_spanner = c('(1) univariate',
'(2) scientist values',
'(3) participant values',
'(4) demographics',
'(5) scientist values alone')) |>
modify_table_body(~ arrange(.x, row_type == "glance_statistic"))
shared_values_tbl| Characteristic | (1) univariate | (2) scientist values | (3) participant values | (4) demographics | (5) scientist values alone | ||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 4.7 | 4.5, 4.9 | <0.001 | 4.6 | 4.4, 4.7 | <0.001 | 4.7 | 4.5, 5.0 | <0.001 | 4.5 | 3.7, 5.3 | <0.001 | 4.6 | 4.5, 4.8 | <0.001 |
| shared values | |||||||||||||||
| shared_values[TRUE] | 0.47 | 0.25, 0.68 | <0.001 | 0.11 | -0.15, 0.37 | 0.4 | 0.10 | -0.16, 0.36 | 0.5 | 0.07 | -0.21, 0.35 | 0.6 | |||
| scientist values | |||||||||||||||
| sci_values[public health] | 0.62 | 0.36, 0.88 | <0.001 | 0.63 | 0.37, 0.89 | <0.001 | 0.62 | 0.34, 0.90 | <0.001 | 0.65 | 0.45, 0.84 | <0.001 | |||
| participant values | |||||||||||||||
| part_values[public health] | -0.18 | -0.44, 0.08 | 0.2 | -0.17 | -0.49, 0.15 | 0.3 | |||||||||
| age | 0.00 | -0.01, 0.01 | 0.7 | ||||||||||||
| rel. serv. attendance | 0.01 | -0.08, 0.10 | 0.9 | ||||||||||||
| political id. | -0.01 | -0.09, 0.06 | 0.8 | ||||||||||||
| education | 0.05 | -0.18, 0.28 | 0.6 | ||||||||||||
| R² | 0.031 | 0.067 | 0.070 | 0.143 | 0.060 | ||||||||||
| No. Obs. | 567 | 567 | 567 | 538 | 660 | ||||||||||
| Adjusted R² | 0.029 | 0.064 | 0.065 | 0.065 | 0.058 | ||||||||||
| Statistic | 18.0 | 20.3 | 14.1 | 1.83 | 41.7 | ||||||||||
| p-value | <0.001 | <0.001 | <0.001 | 0.001 | <0.001 | ||||||||||
| 1 CI = Confidence Interval | |||||||||||||||
write_reg_tbl(shared_values_tbl, here(out_dir, '03_shared_values_tbl'))H5. Variation in effects
## H5. Variation in effects ----The magnitude of the effects above vary depending on whether the participant prioritizes public health or economic growth.
H5-consumer: Consumer risk sensitivity
## H5-consumer ----For consumer risk and transparency penalty, bringing in participant values introduces a potential back-door path through demographics. This is very similar to shared values. Fortunately, as also with shared values, we just need to adjust for part_values (and conclusion).
dag |>
add_arrows(c('part_values -> conclusion_x_part_values <- conclusion',
'conclusion_x_part_values -> METI <- conclusion')) |>
plot_adjustments('conclusion_x_part_values')
model_eb_emad = lm(pa_mean ~ conclusion*part_values, data = emad_df)
summary(model_eb_emad)##
## Call:
## lm(formula = pa_mean ~ conclusion * part_values, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.7437 -0.8610 0.1599 1.0251 2.5965
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 5.4116 0.1417
## conclusion[does not cause harm] -0.5505 0.2026
## part_values[public health] 0.3321 0.1819
## conclusion[does not cause harm]:part_values[public health] -0.7897 0.2557
## t value Pr(>|t|)
## (Intercept) 38.189 < 2e-16 ***
## conclusion[does not cause harm] -2.717 0.00682 **
## part_values[public health] 1.826 0.06853 .
## conclusion[does not cause harm]:part_values[public health] -3.089 0.00213 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.374 on 492 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 0.1429, Adjusted R-squared: 0.1377
## F-statistic: 27.35 on 3 and 492 DF, p-value: 2.243e-16model_eb = lm(meti_mean ~ conclusion*part_values, data = dataf)
summary(model_eb)##
## Call:
## lm(formula = meti_mean ~ conclusion * part_values, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9199 -0.7056 0.0087 0.8658 2.6042
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 5.3876 0.1131
## conclusion[does not cause harm] -0.7541 0.1673
## part_values[public health] 0.1752 0.1312
## conclusion[does not cause harm]:part_values[public health] -0.4128 0.1912
## t value Pr(>|t|)
## (Intercept) 47.632 < 2e-16 ***
## conclusion[does not cause harm] -4.509 7.45e-06 ***
## part_values[public health] 1.335 0.1823
## conclusion[does not cause harm]:part_values[public health] -2.159 0.0311 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.175 on 840 degrees of freedom
## (144 observations deleted due to missingness)
## Multiple R-squared: 0.1763, Adjusted R-squared: 0.1734
## F-statistic: 59.95 on 3 and 840 DF, p-value: < 2.2e-16plot_residuals(model_eb)## `geom_smooth()` using formula 'y ~ x'
plot_predictions(model_eb, c('conclusion', 'part_values'),
interaction_ci = TRUE)
plot_estimate(list(base = model_b, interaction = model_eb),
str_detect(term, 'conclusion'))
list(base = model_b, interaction = model_eb) |>
reg_tbl(labs = c('base', 'interaction'))| Characteristic | base | interaction | ||||
|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.5 | 5.4, 5.6 | <0.001 | 5.4 | 5.2, 5.6 | <0.001 |
| conclusion | ||||||
| conclusion[does not cause harm] | -1.0 | -1.1, -0.84 | <0.001 | -0.75 | -1.1, -0.43 | <0.001 |
| part_values | ||||||
| part_values[public health] | 0.18 | -0.08, 0.43 | 0.2 | |||
| conclusion * part_values | ||||||
| conclusion[does not cause harm] * part_values[public health] | -0.41 | -0.79, -0.04 | 0.031 | |||
| R² | 0.148 | 0.176 | ||||
| No. Obs. | 988 | 844 | ||||
| Adjusted R² | 0.147 | 0.173 | ||||
| Statistic | 171 | 59.9 | ||||
| p-value | <0.001 | <0.001 | ||||
| 1 CI = Confidence Interval | ||||||
Again, include demographics as a check
model_eb1 = lm(meti_mean ~ conclusion*part_values +
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = dataf)
summary(model_eb1)##
## Call:
## lm(formula = meti_mean ~ conclusion * part_values + age + gender +
## race_ethnicity + religious_affil + religious_serv + political_ideology +
## education, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.703 -0.689 0.000 0.815 2.839
##
## Coefficients: (1 not defined because of singularities)
## Estimate
## (Intercept) 5.269896
## conclusion[does not cause harm] -0.725321
## part_values[public health] 0.199800
## age 0.002336
## gender[Man/Male.Man/Male] 0.061406
## gender[Man/Male.Woman/Female] 0.668535
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] -1.420756
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] -1.319357
## gender[Woman/Female.Man/Male] -0.811087
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] -1.813567
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] -0.510207
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 1.197609
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 1.392368
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 0.803310
## gender[Man/Male.Indigenous or other cultural gender minority identity] -1.415886
## gender[Woman/Female.Woman/Female & Man/Male] 1.022698
## race_ethnicity[3] 0.169188
## race_ethnicity[2] 0.008730
## race_ethnicity[4] 0.296248
## race_ethnicity[2,5] -0.344107
## race_ethnicity[4,5] 0.235121
## race_ethnicity[1,5] -0.186294
## race_ethnicity[3,5] 0.620084
## race_ethnicity[1] 0.247225
## race_ethnicity[6] 0.134925
## race_ethnicity[3,4] 0.542722
## race_ethnicity[1,3] 0.652296
## race_ethnicity[1,3,5] 1.425109
## race_ethnicity[1,4,5] -0.506392
## race_ethnicity[2,4,5] 0.910759
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] -1.774866
## religious_affil[6] 0.266205
## religious_affil[2] 0.145139
## religious_affil[8] 0.491350
## religious_affil[9] 0.024232
## religious_affil[4] 0.647875
## religious_affil[1] 0.366487
## religious_affil[5] 0.671171
## religious_affil[3] 0.081191
## religious_affil[7,8] 0.570199
## religious_affil[1,2] 0.535704
## religious_affil[1,6] -0.854535
## religious_affil[1,7] 0.481840
## religious_affil[2,7] 0.009369
## religious_affil[4,7] 0.682151
## religious_affil[6,9] 1.667394
## religious_affil[8,9] 1.191154
## religious_serv -0.014953
## political_ideology -0.022497
## education -0.043906
## conclusion[does not cause harm]:part_values[public health] -0.463876
## Std. Error
## (Intercept) 0.297492
## conclusion[does not cause harm] 0.176724
## part_values[public health] 0.148537
## age 0.002882
## gender[Man/Male.Man/Male] 0.087234
## gender[Man/Male.Woman/Female] 0.834456
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] 0.682826
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] 0.623232
## gender[Woman/Female.Man/Male] 0.593137
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] 1.169456
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] 0.876076
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 1.183602
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 1.168886
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 1.170160
## gender[Man/Male.Indigenous or other cultural gender minority identity] 1.229431
## gender[Woman/Female.Woman/Female & Man/Male] 1.181591
## race_ethnicity[3] 0.133069
## race_ethnicity[2] 0.192705
## race_ethnicity[4] 0.245233
## race_ethnicity[2,5] 0.399441
## race_ethnicity[4,5] 0.481519
## race_ethnicity[1,5] 0.559966
## race_ethnicity[3,5] 0.485083
## race_ethnicity[1] 0.589822
## race_ethnicity[6] 0.606086
## race_ethnicity[3,4] 0.711323
## race_ethnicity[1,3] 1.187150
## race_ethnicity[1,3,5] 1.171498
## race_ethnicity[1,4,5] 1.170419
## race_ethnicity[2,4,5] 1.175382
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] 1.291521
## religious_affil[6] 0.130309
## religious_affil[2] 0.156570
## religious_affil[8] 0.167107
## religious_affil[9] 0.233107
## religious_affil[4] 0.289311
## religious_affil[1] 0.368428
## religious_affil[5] 0.499712
## religious_affil[3] 0.514410
## religious_affil[7,8] 0.830187
## religious_affil[1,2] 1.191750
## religious_affil[1,6] 1.168884
## religious_affil[1,7] 1.185778
## religious_affil[2,7] 1.173376
## religious_affil[4,7] 1.168637
## religious_affil[6,9] 1.169145
## religious_affil[8,9] 1.664191
## religious_serv 0.035004
## political_ideology 0.028822
## education 0.086157
## conclusion[does not cause harm]:part_values[public health] 0.202327
## t value
## (Intercept) 17.714
## conclusion[does not cause harm] -4.104
## part_values[public health] 1.345
## age 0.811
## gender[Man/Male.Man/Male] 0.704
## gender[Man/Male.Woman/Female] 0.801
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] -2.081
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] -2.117
## gender[Woman/Female.Man/Male] -1.367
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] -1.551
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] -0.582
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 1.012
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 1.191
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 0.686
## gender[Man/Male.Indigenous or other cultural gender minority identity] -1.152
## gender[Woman/Female.Woman/Female & Man/Male] 0.866
## race_ethnicity[3] 1.271
## race_ethnicity[2] 0.045
## race_ethnicity[4] 1.208
## race_ethnicity[2,5] -0.861
## race_ethnicity[4,5] 0.488
## race_ethnicity[1,5] -0.333
## race_ethnicity[3,5] 1.278
## race_ethnicity[1] 0.419
## race_ethnicity[6] 0.223
## race_ethnicity[3,4] 0.763
## race_ethnicity[1,3] 0.549
## race_ethnicity[1,3,5] 1.216
## race_ethnicity[1,4,5] -0.433
## race_ethnicity[2,4,5] 0.775
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] -1.374
## religious_affil[6] 2.043
## religious_affil[2] 0.927
## religious_affil[8] 2.940
## religious_affil[9] 0.104
## religious_affil[4] 2.239
## religious_affil[1] 0.995
## religious_affil[5] 1.343
## religious_affil[3] 0.158
## religious_affil[7,8] 0.687
## religious_affil[1,2] 0.450
## religious_affil[1,6] -0.731
## religious_affil[1,7] 0.406
## religious_affil[2,7] 0.008
## religious_affil[4,7] 0.584
## religious_affil[6,9] 1.426
## religious_affil[8,9] 0.716
## religious_serv -0.427
## political_ideology -0.781
## education -0.510
## conclusion[does not cause harm]:part_values[public health] -2.293
## Pr(>|t|)
## (Intercept) < 2e-16
## conclusion[does not cause harm] 4.5e-05
## part_values[public health] 0.17899
## age 0.41789
## gender[Man/Male.Man/Male] 0.48170
## gender[Man/Male.Woman/Female] 0.42329
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] 0.03780
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] 0.03459
## gender[Woman/Female.Man/Male] 0.17189
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male] 0.12138
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female] 0.56049
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid] 0.31194
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid] 0.23396
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity] 0.49261
## gender[Man/Male.Indigenous or other cultural gender minority identity] 0.24983
## gender[Woman/Female.Woman/Female & Man/Male] 0.38703
## race_ethnicity[3] 0.20397
## race_ethnicity[2] 0.96388
## race_ethnicity[4] 0.22742
## race_ethnicity[2,5] 0.38925
## race_ethnicity[4,5] 0.62549
## race_ethnicity[1,5] 0.73946
## race_ethnicity[3,5] 0.20154
## race_ethnicity[1] 0.67523
## race_ethnicity[6] 0.82389
## race_ethnicity[3,4] 0.44572
## race_ethnicity[1,3] 0.58285
## race_ethnicity[1,3,5] 0.22418
## race_ethnicity[1,4,5] 0.66539
## race_ethnicity[2,4,5] 0.43867
## race_ethnicity[5,6] NA
## race_ethnicity[6,7] 0.16978
## religious_affil[6] 0.04141
## religious_affil[2] 0.35423
## religious_affil[8] 0.00338
## religious_affil[9] 0.91724
## religious_affil[4] 0.02542
## religious_affil[1] 0.32019
## religious_affil[5] 0.17964
## religious_affil[3] 0.87463
## religious_affil[7,8] 0.49240
## religious_affil[1,2] 0.65319
## religious_affil[1,6] 0.46497
## religious_affil[1,7] 0.68460
## religious_affil[2,7] 0.99363
## religious_affil[4,7] 0.55959
## religious_affil[6,9] 0.15424
## religious_affil[8,9] 0.47436
## religious_serv 0.66937
## political_ideology 0.43532
## education 0.61048
## conclusion[does not cause harm]:part_values[public health] 0.02214
##
## (Intercept) ***
## conclusion[does not cause harm] ***
## part_values[public health]
## age
## gender[Man/Male.Man/Male]
## gender[Man/Male.Woman/Female]
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid] *
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male] *
## gender[Woman/Female.Man/Male]
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male]
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female]
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid]
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid]
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity]
## gender[Man/Male.Indigenous or other cultural gender minority identity]
## gender[Woman/Female.Woman/Female & Man/Male]
## race_ethnicity[3]
## race_ethnicity[2]
## race_ethnicity[4]
## race_ethnicity[2,5]
## race_ethnicity[4,5]
## race_ethnicity[1,5]
## race_ethnicity[3,5]
## race_ethnicity[1]
## race_ethnicity[6]
## race_ethnicity[3,4]
## race_ethnicity[1,3]
## race_ethnicity[1,3,5]
## race_ethnicity[1,4,5]
## race_ethnicity[2,4,5]
## race_ethnicity[5,6]
## race_ethnicity[6,7]
## religious_affil[6] *
## religious_affil[2]
## religious_affil[8] **
## religious_affil[9]
## religious_affil[4] *
## religious_affil[1]
## religious_affil[5]
## religious_affil[3]
## religious_affil[7,8]
## religious_affil[1,2]
## religious_affil[1,6]
## religious_affil[1,7]
## religious_affil[2,7]
## religious_affil[4,7]
## religious_affil[6,9]
## religious_affil[8,9]
## religious_serv
## political_ideology
## education
## conclusion[does not cause harm]:part_values[public health] *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.164 on 750 degrees of freedom
## (187 observations deleted due to missingness)
## Multiple R-squared: 0.2364, Adjusted R-squared: 0.1855
## F-statistic: 4.645 on 50 and 750 DF, p-value: < 2.2e-16eb_tbl = list(base = model_b, interaction = model_eb, demo = model_eb1) |>
reg_tbl(labs = c('base', 'interaction', 'demographics'))
eb_tbl| Characteristic | base | interaction | demographics | ||||||
|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.5 | 5.4, 5.6 | <0.001 | 5.4 | 5.2, 5.6 | <0.001 | 5.3 | 4.7, 5.9 | <0.001 |
| conclusion | |||||||||
| conclusion[does not cause harm] | -1.0 | -1.1, -0.84 | <0.001 | -0.75 | -1.1, -0.43 | <0.001 | -0.73 | -1.1, -0.38 | <0.001 |
| part_values | |||||||||
| part_values[public health] | 0.18 | -0.08, 0.43 | 0.2 | 0.20 | -0.09, 0.49 | 0.2 | |||
| conclusion * part_values | |||||||||
| conclusion[does not cause harm] * part_values[public health] | -0.41 | -0.79, -0.04 | 0.031 | -0.46 | -0.86, -0.07 | 0.022 | |||
| age | 0.00 | 0.00, 0.01 | 0.4 | ||||||
| religious_serv | -0.01 | -0.08, 0.05 | 0.7 | ||||||
| political_ideology | -0.02 | -0.08, 0.03 | 0.4 | ||||||
| education | -0.04 | -0.21, 0.13 | 0.6 | ||||||
| R² | 0.148 | 0.176 | 0.236 | ||||||
| No. Obs. | 988 | 844 | 801 | ||||||
| Adjusted R² | 0.147 | 0.173 | 0.186 | ||||||
| Statistic | 171 | 59.9 | 4.64 | ||||||
| p-value | <0.001 | <0.001 | <0.001 | ||||||
| 1 CI = Confidence Interval | |||||||||
write_reg_tbl(eb_tbl, here(out_dir, '03_eb_tbl'))
emad_df |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(conclusion, pa_mean)) +
geom_boxplot() +
facet_wrap(vars(part_values))
dataf |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(conclusion, meti_mean)) +
geom_beeswarm(alpha = .5, cex = 1.5, size = .5) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(fun.data = mean_cl_boot, geom = 'line', group = 1L, color = 'red') +
facet_wrap(vars(part_values)) +
labs(x = 'scientist conclusion: BPA ...',
y = 'perceived trustworthiness')
ggsave(here(out_dir, '03_conclusion_part.png'),
height = 3, width = 6, scale = 1,
bg = 'white')H5-transparency
## H5-transparency ----
dag |>
add_arrows(c('part_values -> disclosure_x_part_values <- disclosure',
'disclosure_x_part_values -> METI',
'disclosure -> METI')) |>
plot_adjustments('disclosure_x_part_values')
model_ec_emad = lm(pa_mean ~ disclosure*part_values, data = emad_df)
summary(model_ec_emad)##
## Call:
## lm(formula = pa_mean ~ disclosure * part_values, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.4090 -1.0042 0.1387 1.1446 2.1387
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.35272 0.18476 28.971
## disclosure[TRUE] -0.32001 0.22784 -1.405
## part_values[public health] 0.05629 0.23878 0.236
## disclosure[TRUE]:part_values[public health] -0.22770 0.29095 -0.783
## Pr(>|t|)
## (Intercept) <2e-16 ***
## disclosure[TRUE] 0.161
## part_values[public health] 0.814
## disclosure[TRUE]:part_values[public health] 0.434
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.466 on 492 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 0.02353, Adjusted R-squared: 0.01758
## F-statistic: 3.953 on 3 and 492 DF, p-value: 0.008371lm(pa_mean ~ disclosure*part_values+
sex + ideology + educatio + age, data = emad_df) |>
summary()##
## Call:
## lm(formula = pa_mean ~ disclosure * part_values + sex + ideology +
## educatio + age, data = emad_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.2393 -0.9427 0.1744 1.1730 2.2864
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.227099 0.334903 15.608
## disclosure[TRUE] -0.323021 0.228681 -1.413
## part_values[public health] 0.003625 0.243423 0.015
## sex 0.025026 0.134675 0.186
## ideology 0.007676 0.042153 0.182
## educatio -0.084100 0.064652 -1.301
## age 0.069062 0.031725 2.177
## disclosure[TRUE]:part_values[public health] -0.256452 0.291972 -0.878
## Pr(>|t|)
## (Intercept) <2e-16 ***
## disclosure[TRUE] 0.158
## part_values[public health] 0.988
## sex 0.853
## ideology 0.856
## educatio 0.194
## age 0.030 *
## disclosure[TRUE]:part_values[public health] 0.380
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.459 on 484 degrees of freedom
## (6 observations deleted due to missingness)
## Multiple R-squared: 0.03626, Adjusted R-squared: 0.02232
## F-statistic: 2.601 on 7 and 484 DF, p-value: 0.01212model_ec = lm(meti_mean ~ disclosure*part_values, data = dataf)
summary(model_ec)##
## Call:
## lm(formula = meti_mean ~ disclosure * part_values, data = dataf)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9023 -0.9061 0.0977 1.0263 2.0977
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.01557 0.14634 34.273
## disclosure[TRUE] 0.04464 0.18767 0.238
## part_values[public health] 0.07453 0.17265 0.432
## disclosure[TRUE]:part_values[public health] -0.23243 0.21762 -1.068
## Pr(>|t|)
## (Intercept) <2e-16 ***
## disclosure[TRUE] 0.812
## part_values[public health] 0.666
## disclosure[TRUE]:part_values[public health] 0.286
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.292 on 840 degrees of freedom
## (144 observations deleted due to missingness)
## Multiple R-squared: 0.004245, Adjusted R-squared: 0.0006885
## F-statistic: 1.194 on 3 and 840 DF, p-value: 0.3111plot_residuals(model_ec)## `geom_smooth()` using formula 'y ~ x'
plot_estimate(list(base = model_c, interaction = model_ec),
str_detect(term, 'disclosure'))
plot_predictions(model_ec, c('disclosure', 'part_values'),
interaction_ci = TRUE)
model_ec1 = lm(meti_mean ~ disclosure * part_values +
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = dataf)
ec_tbl = list(base = model_c,
interaction = model_ec,
demographics = model_ec1) |>
reg_tbl(labs = c('base', 'interaction', 'demographics'))
ec_tbl| Characteristic | base | interaction | demographics | ||||||
|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 5.1 | 4.9, 5.2 | <0.001 | 5.0 | 4.7, 5.3 | <0.001 | 4.9 | 4.3, 5.6 | <0.001 |
| disclosure | |||||||||
| disclosure[TRUE] | -0.11 | -0.28, 0.06 | 0.2 | 0.04 | -0.32, 0.41 | 0.8 | 0.05 | -0.34, 0.43 | 0.8 |
| part_values | |||||||||
| part_values[public health] | 0.07 | -0.26, 0.41 | 0.7 | 0.14 | -0.23, 0.51 | 0.5 | |||
| disclosure * part_values | |||||||||
| disclosure[TRUE] * part_values[public health] | -0.23 | -0.66, 0.19 | 0.3 | -0.29 | -0.74, 0.15 | 0.2 | |||
| age | 0.00 | 0.00, 0.01 | 0.5 | ||||||
| religious_serv | 0.02 | -0.06, 0.09 | 0.7 | ||||||
| political_ideology | -0.02 | -0.08, 0.04 | 0.5 | ||||||
| education | -0.07 | -0.26, 0.11 | 0.4 | ||||||
| R² | 0.002 | 0.004 | 0.071 | ||||||
| No. Obs. | 988 | 844 | 801 | ||||||
| Adjusted R² | 0.001 | 0.001 | 0.009 | ||||||
| Statistic | 1.60 | 1.19 | 1.15 | ||||||
| p-value | 0.2 | 0.3 | 0.2 | ||||||
| 1 CI = Confidence Interval | |||||||||
write_reg_tbl(ec_tbl, here(out_dir, '03_ec_tbl'))
dataf |>
filter(!is.na(part_values)) |>
ggplot(aes(disclosure, meti_mean)) +
geom_boxplot() +
# geom_beeswarm(alpha = .25) +
facet_wrap(vars(part_values))
H5-shared
## H5-shared ----Initially it seems like we can proceed as we did with the other interactions: we need to adjust for participant values and shared values, but that’s all. In particular, no need to adjust for scientist values.
dag |>
add_arrows(c('part_values -> shared_values_x_part_values <- shared_values',
'shared_values_x_part_values -> METI')) |>
plot_adjustments('shared_values_x_part_values')
# model_ed_emad = emad_df |>
# filter(disclosure) %>%
# lm(pa_mean ~ shared_values*part_values, data = .)
# summary(model_ed_emad)
# emad_df |>
# filter(disclosure) %>%
# lm(pa_mean ~ shared_values*part_values+
# sex + ideology + educatio + age, data = .) |>
# summary()
model_ed = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values*part_values, data = .)
summary(model_ed)##
## Call:
## lm(formula = meti_mean ~ shared_values * part_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8416 -0.8981 -0.0559 0.9590 2.4590
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.3494 0.1733 30.869
## shared_values[TRUE] -0.5301 0.2346 -2.259
## part_values[public health] -0.8084 0.1933 -4.182
## shared_values[TRUE]:part_values[public health] 1.2593 0.2643 4.764
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## shared_values[TRUE] 0.0243 *
## part_values[public health] 3.35e-05 ***
## shared_values[TRUE]:part_values[public health] 2.41e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 563 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.0701, Adjusted R-squared: 0.06514
## F-statistic: 14.15 on 3 and 563 DF, p-value: 6.696e-09But that finds that shared values as a statistically significant negative primary effect for shared values? That’s weird. We saw above that the estimate for shared values was biased unless we included scientist values. So let’s try to include it in the model. This results in perfect collinearity.
dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values*part_values + sci_values, data = .) |>
summary()##
## Call:
## lm(formula = meti_mean ~ shared_values * part_values + sci_values,
## data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8416 -0.8981 -0.0559 0.9590 2.4590
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value
## (Intercept) 4.71968 0.13216 35.711
## shared_values[TRUE] 0.09958 0.13216 0.753
## part_values[public health] -0.17873 0.13216 -1.352
## sci_values[public health] 0.62967 0.13216 4.764
## shared_values[TRUE]:part_values[public health] NA NA NA
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## shared_values[TRUE] 0.451
## part_values[public health] 0.177
## sci_values[public health] 2.41e-06 ***
## shared_values[TRUE]:part_values[public health] NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 563 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.0701, Adjusted R-squared: 0.06514
## F-statistic: 14.15 on 3 and 563 DF, p-value: 6.696e-09Comparing to our model for H4 makes it clear that this interaction model is misspecified
model_ed1 = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values*part_values+
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = .)
list(model_d, model_ed, model_ed1) |>
reg_tbl(labs = c('base', 'interaction', 'demographics'))| Characteristic | base | interaction | demographics | ||||||
|---|---|---|---|---|---|---|---|---|---|
| Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | Beta | 95% CI1 | p-value | |
| (Intercept) | 4.7 | 4.5, 5.0 | <0.001 | 5.3 | 5.0, 5.7 | <0.001 | 5.1 | 4.3, 5.9 | <0.001 |
| shared_values | |||||||||
| shared_values[TRUE] | 0.10 | -0.16, 0.36 | 0.5 | -0.53 | -1.0, -0.07 | 0.024 | -0.55 | -1.1, -0.05 | 0.031 |
| part_values | |||||||||
| part_values[public health] | -0.18 | -0.44, 0.08 | 0.2 | -0.81 | -1.2, -0.43 | <0.001 | -0.79 | -1.2, -0.36 | <0.001 |
| sci_values | |||||||||
| sci_values[public health] | 0.63 | 0.37, 0.89 | <0.001 | ||||||
| shared_values * part_values | |||||||||
| shared_values[TRUE] * part_values[public health] | 1.3 | 0.74, 1.8 | <0.001 | 1.2 | 0.68, 1.8 | <0.001 | |||
| age | 0.00 | -0.01, 0.01 | 0.7 | ||||||
| religious_serv | 0.01 | -0.08, 0.10 | 0.9 | ||||||
| political_ideology | -0.01 | -0.09, 0.06 | 0.8 | ||||||
| education | 0.05 | -0.18, 0.28 | 0.6 | ||||||
| R² | 0.070 | 0.070 | 0.143 | ||||||
| No. Obs. | 567 | 567 | 538 | ||||||
| Adjusted R² | 0.065 | 0.065 | 0.065 | ||||||
| Statistic | 14.1 | 14.1 | 1.83 | ||||||
| p-value | <0.001 | <0.001 | 0.001 | ||||||
| 1 CI = Confidence Interval | |||||||||
Plot mean + CI by participant and shared values. It looks like there’s an interaction here: shared values might be positive or negative, depending on the participants’ values.
dataf |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(shared_values, meti_mean)) +
# geom_boxplot() +
geom_beeswarm(alpha = .5, cex = 1.5, size = .5) +
facet_wrap(vars(part_values)) +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(fun.data = mean_cl_boot, geom = 'line', group = 1L, color = 'red') +
labs(x = 'shared values',
y = 'perceived trustworthiness')
ggsave(here(out_dir, '03_shared_part.png'),
height = 3, width = 6, scale = 1,
bg = 'white')Could this be due to political ideology? No: it appears to be either entirely upstream or independent to this
dataf |>
filter(disclosure) %>%
lm(meti_mean ~ shared_values*part_values + political_ideology, data = .) |>
summary()##
## Call:
## lm(formula = meti_mean ~ shared_values * part_values + political_ideology,
## data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8353 -0.8809 -0.0615 0.9464 2.4839
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 5.396724 0.240008 22.486
## shared_values[TRUE] -0.518383 0.240109 -2.159
## part_values[public health] -0.856955 0.206333 -4.153
## political_ideology -0.003948 0.033497 -0.118
## shared_values[TRUE]:part_values[public health] 1.262260 0.269799 4.679
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## shared_values[TRUE] 0.0313 *
## part_values[public health] 3.81e-05 ***
## political_ideology 0.9062
## shared_values[TRUE]:part_values[public health] 3.66e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.274 on 536 degrees of freedom
## (119 observations deleted due to missingness)
## Multiple R-squared: 0.07522, Adjusted R-squared: 0.06832
## F-statistic: 10.9 on 4 and 536 DF, p-value: 1.675e-08Apparently independent. Interesting: No correlation between political ideology and trust? Very unexpected, given the narrative that trust in science is politically polarized!
dataf |>
filter(disclosure) %>%
lm(meti_mean ~ political_ideology, data = .) |>
summary()##
## Call:
## lm(formula = meti_mean ~ political_ideology, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9494 -0.9437 0.0569 1.0506 2.0633
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.954527 0.105865 46.80 <2e-16 ***
## political_ideology -0.002545 0.028266 -0.09 0.928
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.322 on 628 degrees of freedom
## (30 observations deleted due to missingness)
## Multiple R-squared: 1.291e-05, Adjusted R-squared: -0.001579
## F-statistic: 0.008105 on 1 and 628 DF, p-value: 0.9283dataf |>
filter(disclosure) |>
ggplot(aes(political_ideology, meti_mean, group = political_ideology)) +
geom_violin(draw_quantiles = .5) +
geom_beeswarm()## Warning: Removed 30 rows containing non-finite values (stat_ydensity).## Warning: Removed 30 rows containing missing values (position_beeswarm).
Scientist values
## Scientist values ---The confusing “shared values interaction” effect is just the effect of scientist values, from H4
model_es = dataf |>
filter(disclosure) %>%
lm(meti_mean ~ sci_values + part_values, data = .)
summary(model_es)##
## Call:
## lm(formula = meti_mean ~ sci_values + part_values, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8203 -0.8918 -0.0619 0.9659 2.4381
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.7479 0.1267 37.478 < 2e-16 ***
## sci_values[public health] 0.6870 0.1080 6.361 4.14e-10 ***
## part_values[public health] -0.1861 0.1318 -1.412 0.158
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 564 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.06916, Adjusted R-squared: 0.06586
## F-statistic: 20.95 on 2 and 564 DF, p-value: 1.671e-09plot_predictions(model_es, 'sci_values')
dataf |>
filter(!is.na(part_values), disclosure) |>
ggplot(aes(sci_values, meti_mean)) +
# geom_boxplot() +
geom_beeswarm(alpha = .5, cex = 1.5, size = .5) +
facet_wrap(vars(part_values)) +
# geom_ribbon(data = plot_predictions(model_es,
# c('sci_values', 'part_values'),
# return_plot = FALSE),
# aes(y = .fitted, ymin = .lower, ymax = .upper),
# group = 1L, alpha = .5, fill = 'blue') +
# geom_line(data = plot_predictions(model_es,
# c('sci_values', 'part_values'),
# return_plot = FALSE),
# aes(y = .fitted, ymin = .lower, ymax = .upper),
# group = 1L, alpha = 1, color = 'blue') +
stat_summary(fun.data = mean_cl_boot, color = 'red',
size = 1, fatten = 0) +
stat_summary(fun.data = mean_cl_boot, geom = 'line', group = 1L, color = 'red') +
labs(x = 'scientist values',
y = 'perceived trustworthiness')
ggsave(here(out_dir, '03_sci_part.png'), height = 3, width = 6, scale = 1, bg = 'white')Any interaction with participant values is swamped by uncertainty.
Though Emilio thinks this might be worth reporting because of difference in variation — wider for economic growth participants. OTOH there are just a lot fewer of these participants, so SEs are larger.
How are participants thinking of economic growth? Might be thinking of indirect effects, eg, good economy -> better hospitals and public health system
dataf %>%
filter(disclosure) %>%
lm(meti_mean ~ sci_values*part_values, data = .) |>
# summary()
plot_predictions(c('sci_values', 'part_values'),
interaction_ci = TRUE)
lm(meti_mean ~ sci_values * part_values,
data = filter(dataf, disclosure)) |>
summary()##
## Call:
## lm(formula = meti_mean ~ sci_values * part_values, data = filter(dataf,
## disclosure))
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.8416 -0.8981 -0.0559 0.9590 2.4590
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 4.8193 0.1582
## sci_values[public health] 0.5301 0.2346
## part_values[public health] -0.2783 0.1799
## sci_values[public health]:part_values[public health] 0.1992 0.2643
## t value Pr(>|t|)
## (Intercept) 30.464 <2e-16 ***
## sci_values[public health] 2.259 0.0243 *
## part_values[public health] -1.547 0.1224
## sci_values[public health]:part_values[public health] 0.753 0.4515
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 563 degrees of freedom
## (93 observations deleted due to missingness)
## Multiple R-squared: 0.0701, Adjusted R-squared: 0.06514
## F-statistic: 14.15 on 3 and 563 DF, p-value: 6.696e-09sci_part_tbl = list(base = model_s,
part_values = model_es,
interaction = lm(meti_mean ~ sci_values * part_values,
data = filter(dataf, disclosure)),
demographics = lm(meti_mean ~ sci_values * part_values +
age + gender + race_ethnicity + religious_affil +
religious_serv + political_ideology + education,
data = filter(dataf, disclosure))) |>
reg_tbl(labs = c('base', 'participant values',
'interaction', 'demographics'))
write_reg_tbl(sci_part_tbl, here(out_dir, '03_sci_part_tbl'))